home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 050 / disk_425.arc / SOLVGJ.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1985-04-03  |  1.7 KB  |  100 lines
  1. program solvgj;        { -> 84 }
  2. { pascal program to perform simultaneous solution by Gauss-Jordan elimination}
  3.  
  4. const    maxr    = 8;
  5.     maxc    = 8;
  6.  
  7. type    ary    = array[1..maxr] of real;
  8.     arys    = array[1..maxc] of real;
  9.     ary2s    = array[1..maxr,1..maxc] of real;
  10.  
  11. var    y    : arys;
  12.     coef    : arys;
  13.     a,b    : ary2s;
  14.     n,m,i,j    : integer;
  15.     first,
  16.     error    : boolean;
  17.  
  18. external procedure cls;
  19.  
  20. procedure get_data(var a: ary2s;
  21.            var y: arys;
  22.            var n,m: integer);
  23.  
  24. { get the values for n and arrays a,y }
  25.  
  26. var    i,j    : integer;
  27.  
  28. begin
  29.   writeln;
  30.   repeat
  31.     write('How many equations? ');
  32.     readln(n);
  33.     if first then first:=false else cls;
  34.     m:=n
  35.   until n<maxr;
  36.   if n>1 then
  37.     begin
  38.       for i:=1 to n do
  39.     begin
  40.       writeln('Equation',i:3);
  41.       for j:=1 to n do
  42.         begin
  43.           write(j:3,':');
  44.           read(a[i,j])
  45.         end;
  46.       write(',C:');
  47.       readln(y[i])    { clear line }
  48.     end;
  49.       writeln;
  50.       for i:=1 to n do
  51.     begin
  52.       for j:=1 to m do
  53.         write(a[i,j]:7:4,' ');
  54.       writeln(':',y[i]:7:4)
  55.     end;
  56.       writeln
  57.     end        { if n>1 }
  58. end;    { procedure get_data }
  59.  
  60. procedure write_data;
  61.  
  62. { print out the answers }
  63.  
  64. var    i    : integer;
  65.  
  66. begin
  67.   for i:=1 to m do
  68.     write(coef[i]:9:5);
  69.   writeln
  70. end;    { write_data }
  71.  
  72.  
  73.  
  74. {external procedure gaussj
  75.  (var        b : ary2s;
  76.         y : arys;
  77.   var         coef : arys;
  78.          ncol : integer;
  79.   var        error : boolean);}
  80.  
  81. {$I C:GAUSSJ.LIB}
  82.  
  83. begin        { MAIN program }
  84.   first:=true;
  85.   cls;
  86.   writeln;
  87.   writeln('Simultanuns solution by Gauss-Jordan elimination');
  88.   repeat
  89.     get_data(a,y,n,m);
  90.     if n>1 then
  91.       begin
  92.     for i:=1 to n do
  93.       for j:=1 to n do
  94.         b[i,j]:=a[i,j];    { setup work array }
  95.     gaussj(b,y,coef,n,error);
  96.     if not error then write_data
  97.       end
  98.   until n<2
  99. end.
  100.